home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kolekce / d6 / rxlibsetup.exe / {app} / units / SBSETUP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-02-19  |  11.0 KB  |  381 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 2001,2002 SGB Software          }
  6. {         Copyright (c) 1997, 1998 Fedor Koshevnikov,   }
  7. {                        Igor Pavluk and Serge Korolev  }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11.  
  12. unit SbSetup;
  13.  
  14. interface
  15.  
  16. {$I RX.INC}
  17.  
  18. uses
  19. {$IFDEF WIN32}
  20.   Windows,
  21. {$ELSE}
  22.   WinTypes, WinProcs,
  23. {$ENDIF WIN32}
  24.   SysUtils, Messages, Classes, Graphics, Controls, Forms, Dialogs,
  25.   StdCtrls, Buttons, Grids, RxCtrls, SpeedBar, ExtCtrls, RxConst;
  26.  
  27. type
  28.   TSpeedbarSetupWindow = class(TForm)
  29.     ButtonsList: TDrawGrid;
  30.     ButtonsLabel: TLabel;
  31.     SectionList: TDrawGrid;
  32.     CategoriesLabel: TLabel;
  33.     Bevel1: TBevel;
  34.     HintLabel: TLabel;
  35.     CloseBtn: TButton;
  36.     HelpBtn: TButton;
  37.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  38.     procedure SectionListSelectCell(Sender: TObject; Col, Row: Longint;
  39.       var CanSelect: Boolean);
  40.     procedure SectionListDrawCell(Sender: TObject; Col, Row: Longint;
  41.       Rect: TRect; State: TGridDrawState);
  42.     procedure ButtonsListMouseDown(Sender: TObject; Button: TMouseButton;
  43.       Shift: TShiftState; X, Y: Integer);
  44.     procedure ButtonsListMouseMove(Sender: TObject; Shift: TShiftState; X,
  45.       Y: Integer);
  46.     procedure ButtonsListMouseUp(Sender: TObject; Button: TMouseButton;
  47.       Shift: TShiftState; X, Y: Integer);
  48.     procedure ButtonsListSelectCell(Sender: TObject; Col, Row: Longint;
  49.       var CanSelect: Boolean);
  50.     procedure FormCreate(Sender: TObject);
  51.     procedure FormDestroy(Sender: TObject);
  52.     procedure ButtonsListDrawCell(Sender: TObject; Col, Row: Longint;
  53.       Rect: TRect; State: TGridDrawState);
  54.     procedure CloseBtnClick(Sender: TObject);
  55.     procedure HelpBtnClick(Sender: TObject);
  56.     procedure FormShow(Sender: TObject);
  57.   private
  58.     { Private declarations }
  59.     FButton: TBtnControl;
  60.     FImage: TButtonImage;
  61.     FBar: TSpeedBar;
  62.     FDrag: Boolean;
  63.     FDragItem: TSpeedItem;
  64.     procedure UpdateHint(Section, Row: Integer);
  65.     function CheckSpeedBar: Boolean;
  66.     function CurrentSection: Integer;
  67.     procedure SetSection(Section: Integer);
  68.     procedure UpdateCurrentSection;
  69.     procedure UpdateData(Section: Integer);
  70.     procedure UpdateListHeight;
  71.     procedure SetSpeedBar(Value: TSpeedBar);
  72.     function ItemByRow(Row: Integer): TSpeedItem;
  73.     procedure CMSpeedBarChanged(var Message: TMessage); message CM_SPEEDBARCHANGED;
  74.   public
  75.     { Public declarations }
  76.     property SpeedBar: TSpeedBar read FBar write SetSpeedBar;
  77.   end;
  78.  
  79. procedure ShowSpeedbarSetupWindow(Speedbar: TSpeedbar; HelpCtx: THelpContext);
  80.  
  81. implementation
  82.  
  83. uses VCLUtils, MaxMin, Consts, RXTConst;
  84.  
  85. {$R *.DFM}
  86.  
  87. function FindEditor(Speedbar: TSpeedbar): TSpeedbarSetupWindow;
  88. var
  89.   I: Integer;
  90. begin
  91.   Result := nil;
  92.   for I := 0 to Screen.FormCount - 1 do begin
  93.     if Screen.Forms[I] is TSpeedbarSetupWindow then begin
  94.       if TSpeedbarSetupWindow(Screen.Forms[I]).SpeedBar = SpeedBar then
  95.       begin
  96.         Result := TSpeedbarSetupWindow(Screen.Forms[I]);
  97.         Break;
  98.       end;
  99.     end;
  100.   end;
  101. end;
  102.  
  103. procedure ShowSpeedbarSetupWindow(Speedbar: TSpeedbar; HelpCtx: THelpContext);
  104. var
  105.   Editor: TSpeedbarSetupWindow;
  106. begin
  107.   if Speedbar = nil then Exit;
  108.   Editor := FindEditor(Speedbar);
  109.   if Editor = nil then begin
  110.     Editor := TSpeedbarSetupWindow.Create(Application);
  111.     Editor.Speedbar := Speedbar;
  112.   end;
  113.   try
  114.     if HelpCtx > 0 then Editor.HelpContext := HelpCtx;
  115. {$IFDEF WIN32}
  116.     Editor.BorderIcons := [biSystemMenu];
  117. {$ENDIF}
  118.     Editor.HelpBtn.Visible := (HelpCtx > 0);
  119.     Editor.Show;
  120.     if Editor.WindowState = wsMinimized then Editor.WindowState := wsNormal;
  121.   except
  122.     Editor.Free;
  123.     raise;
  124.   end;
  125. end;
  126.  
  127. { TSpeedbarSetupWindow }
  128.  
  129. const
  130.   MaxBtnListHeight = 186;
  131.  
  132. function TSpeedbarSetupWindow.CheckSpeedBar: Boolean;
  133. begin
  134.   Result := (FBar <> nil) and (FBar.Owner <> nil) and
  135.     (FBar.Parent <> nil);
  136. end;
  137.  
  138. function TSpeedbarSetupWindow.CurrentSection: Integer;
  139. begin
  140.   if CheckSpeedBar and (FBar.SectionCount > 0) then
  141.     Result := SectionList.Row
  142.   else Result := -1;
  143. end;
  144.  
  145. procedure TSpeedbarSetupWindow.SetSection(Section: Integer);
  146. var
  147.   I: Integer;
  148. begin
  149.   if CheckSpeedBar then begin
  150.     I := Section;
  151.     if (I >= 0) and (FBar.SectionCount > 0) then
  152.       ButtonsList.RowCount := FBar.ItemsCount(I)
  153.     else ButtonsList.RowCount := 0;
  154.     SectionList.DefaultColWidth := SectionList.ClientWidth;
  155.     ButtonsList.DefaultColWidth := ButtonsList.ClientWidth;
  156.     UpdateHint(I, ButtonsList.Row);
  157.   end;
  158. end;
  159.  
  160. procedure TSpeedbarSetupWindow.UpdateCurrentSection;
  161. begin
  162.   SetSection(CurrentSection);
  163. end;
  164.  
  165. procedure TSpeedbarSetupWindow.UpdateData(Section: Integer);
  166. begin
  167.   if CheckSpeedBar then begin
  168.     SectionList.RowCount := FBar.SectionCount;
  169.     UpdateCurrentSection;
  170.     if (Section >= 0) and (Section < SectionList.RowCount) then
  171.       SectionList.Row := Section;
  172.   end
  173.   else begin
  174.     SectionList.RowCount := 0;
  175.     ButtonsList.RowCount := 0;
  176.   end;
  177. end;
  178.  
  179. procedure TSpeedbarSetupWindow.UpdateListHeight;
  180. var
  181.   Cnt: Integer;
  182.   MaxHeight: Integer;
  183. begin
  184.   Canvas.Font := Font;
  185.   MaxHeight := MulDiv(MaxBtnListHeight, Screen.PixelsPerInch, 96);
  186.   ButtonsList.DefaultRowHeight := FBar.BtnHeight + 2;
  187.   Cnt := Max(1, Max(ButtonsList.ClientHeight, MaxHeight) div
  188.     (FBar.BtnHeight + 2));
  189.   ButtonsList.ClientHeight := Min(MaxHeight,
  190.     ButtonsList.DefaultRowHeight * Cnt);
  191.   SectionList.ClientHeight := ButtonsList.ClientHeight;
  192.   SectionList.DefaultRowHeight := Canvas.TextHeight('Wg') + 2;
  193. end;
  194.  
  195. procedure TSpeedbarSetupWindow.SetSpeedBar(Value: TSpeedBar);
  196. begin
  197.   if FBar <> Value then begin
  198.     if FBar <> nil then FBar.SetEditing(0);
  199.     FBar := Value;
  200.     if FBar <> nil then begin
  201.       FBar.SetEditing(Handle);
  202.       UpdateListHeight;
  203.     end;
  204.     UpdateData(-1);
  205.   end;
  206. end;
  207.  
  208. procedure TSpeedbarSetupWindow.CMSpeedBarChanged(var Message: TMessage);
  209. begin
  210.   if Pointer(Message.LParam) = FBar then begin
  211.     case Message.WParam of
  212.       SBR_CHANGED: UpdateData(CurrentSection);
  213.       SBR_DESTROYED: Close;
  214.       SBR_BTNSIZECHANGED: if FBar <> nil then UpdateListHeight;
  215.     end;
  216.   end;
  217. end;
  218.  
  219. function TSpeedbarSetupWindow.ItemByRow(Row: Integer): TSpeedItem;
  220. begin
  221.   Result := FBar.Items(CurrentSection, Row);
  222. end;
  223.  
  224. procedure TSpeedbarSetupWindow.UpdateHint(Section, Row: Integer);
  225. var
  226.   Item: TSpeedItem;
  227. begin
  228.   Item := FBar.Items(Section, Row);
  229.   if Item <> nil then Hint := Item.Hint
  230.   else Hint := '';
  231. end;
  232.  
  233. procedure TSpeedbarSetupWindow.FormClose(Sender: TObject; var Action: TCloseAction);
  234. begin
  235.   Action := caFree;
  236.   FButton.Free;
  237.   FButton := nil;
  238.   if FBar <> nil then FBar.SetEditing(0);
  239.   FBar := nil;
  240. end;
  241.  
  242. procedure TSpeedbarSetupWindow.SectionListSelectCell(Sender: TObject; Col,
  243.   Row: Longint; var CanSelect: Boolean);
  244. begin
  245.   CanSelect := False;
  246.   SetSection(Row);
  247.   CanSelect := True;
  248. end;
  249.  
  250. procedure TSpeedbarSetupWindow.SectionListDrawCell(Sender: TObject; Col,
  251.   Row: Longint; Rect: TRect; State: TGridDrawState);
  252. begin
  253.   if CheckSpeedBar then begin
  254.     if Row < FBar.SectionCount then begin
  255.       DrawCellText(Sender as TDrawGrid, Col, Row,
  256.         FBar.Sections[Row].Caption, Rect, taLeftJustify, vaCenter
  257.         {$IFDEF RX_D4}, TDrawGrid(Sender).IsRightToLeft {$ENDIF});
  258.     end;
  259.   end;
  260. end;
  261.  
  262. procedure TSpeedbarSetupWindow.ButtonsListMouseDown(Sender: TObject;
  263.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  264. var
  265.   Item: TSpeedItem;
  266. begin
  267.   Item := ItemByRow(ButtonsList.Row);
  268.   if (Item <> nil) and (X < FBar.BtnWidth + 2) and (Button = mbLeft) then
  269.   begin
  270.     FDrag := True;
  271.     if Item.Visible then FDragItem := nil
  272.     else begin
  273.       FDragItem := Item;
  274.       if FButton = nil then begin
  275.         FButton := TBtnControl.Create(Self);
  276.         FButton.AssignSpeedItem(Item);
  277.       end;
  278.     end;
  279.   end;
  280. end;
  281.  
  282. procedure TSpeedbarSetupWindow.ButtonsListMouseMove(Sender: TObject;
  283.   Shift: TShiftState; X, Y: Integer);
  284. var
  285.   P: TPoint;
  286. begin
  287.   if FDrag and (FButton <> nil) and (FDragItem <> nil) then begin
  288.     P := (Sender as TControl).ClientToScreen(Point(X, Y));
  289.     X := P.X - (FButton.Width {div 2});
  290.     Y := P.Y - (FButton.Height {div 2});
  291.     FButton.Activate(Bounds(X, Y, FBar.BtnWidth, FBar.BtnHeight));
  292.   end
  293.   else if FDrag then SetCursor(Screen.Cursors[crNoDrop]);
  294. end;
  295.  
  296. procedure TSpeedbarSetupWindow.ButtonsListMouseUp(Sender: TObject;
  297.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  298. var
  299.   P: TPoint;
  300. begin
  301.   if FDrag and (Button = mbLeft) then
  302.   try
  303.     if (FDragItem <> nil) and (FButton <> nil) then begin
  304.       Dec(X, FButton.Width {div 2});
  305.       Dec(Y, FButton.Height {div 2});
  306.       P := (Sender as TControl).ClientToScreen(Point(X, Y));
  307.       FButton.Free;
  308.       FButton := nil;
  309.       if CheckSpeedBar and (FBar = FindSpeedBar(P)) then begin
  310.         P := FBar.ScreenToClient(P);
  311.         if FBar.AcceptDropItem(FDragItem, P.X, P.Y) then
  312.           UpdateCurrentSection;
  313.       end;
  314.     end
  315.     else SetCursor(Screen.Cursors[ButtonsList.Cursor]);
  316.   finally
  317.     FDrag := False;
  318.     FDragItem := nil;
  319.   end;
  320. end;
  321.  
  322. procedure TSpeedbarSetupWindow.ButtonsListSelectCell(Sender: TObject; Col,
  323.   Row: Longint; var CanSelect: Boolean);
  324. begin
  325.   CanSelect := not FDrag or (Row = ButtonsList.Row);
  326.   if CanSelect then UpdateHint(CurrentSection, Row)
  327.   else Hint := '';
  328. end;
  329.  
  330. procedure TSpeedbarSetupWindow.FormCreate(Sender: TObject);
  331. begin
  332.   FImage := TButtonImage.Create;
  333.   FButton := nil;
  334.   FBar := nil;
  335.   FDrag := False;
  336.   CloseBtn.Default := False;
  337.   if NewStyleControls then Font.Style := [];
  338.   { Load string resources }
  339.   CloseBtn.Caption := ResStr(SOKButton);
  340.   HelpBtn.Caption := ResStr(SHelpButton);
  341.   Caption := LoadStr(SCustomizeSpeedbar);
  342.   CategoriesLabel.Caption := LoadStr(SSpeedbarCategories);
  343.   ButtonsLabel.Caption := LoadStr(SAvailButtons);
  344.   HintLabel.Caption := LoadStr(SSpeedbarEditHint);
  345. end;
  346.  
  347. procedure TSpeedbarSetupWindow.FormDestroy(Sender: TObject);
  348. begin
  349.   FImage.Free;
  350. end;
  351.  
  352. procedure TSpeedbarSetupWindow.ButtonsListDrawCell(Sender: TObject; Col,
  353.   Row: Longint; Rect: TRect; State: TGridDrawState);
  354. var
  355.   I: Integer;
  356. begin
  357.   I := CurrentSection;
  358.   if (I >= 0) and (Row < FBar.ItemsCount(I)) then
  359.     DrawCellButton(Sender as TDrawGrid, Rect, ItemByRow(Row), FImage
  360.       {$IFDEF RX_D4}, TDrawGrid(Sender).IsRightToLeft {$ENDIF});
  361. end;
  362.  
  363. procedure TSpeedbarSetupWindow.CloseBtnClick(Sender: TObject);
  364. begin
  365.   Close;
  366. end;
  367.  
  368. procedure TSpeedbarSetupWindow.HelpBtnClick(Sender: TObject);
  369. begin
  370.   Application.HelpContext(HelpContext);
  371. end;
  372.  
  373. procedure TSpeedbarSetupWindow.FormShow(Sender: TObject);
  374. begin
  375.   if FBar <> nil then UpdateListHeight;
  376.   SectionList.DefaultColWidth := SectionList.ClientWidth;
  377.   ButtonsList.DefaultColWidth := ButtonsList.ClientWidth;
  378. end;
  379.  
  380. end.
  381.